Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue59/Arch/Extended Sample/UnitFormBase.pas

Pascal/Delphi Source File | 2000-06-05 | 5.9 KB | 229 lines

unit UnitFormBase;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UnitObjectBase, dbtables, ImgList;

type
  TFormBase = class;
  TFormBaseClass = class of TFormBase;
  TFormBase = class(TForm)
    ImageListBase: TImageList;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    FKey: integer;
    FBusinessObject: TObjectBase;
    constructor PrivateCreate(Owner: TComponent);
    procedure AncestorInitializeForm;
    procedure AncestorFinalizeForm;
    public function EqualsSignature(aFormClass: TFormBaseClass; const anKey: integer): boolean;

  protected
    FStringsFieldForceRole: TStrings;
    class function FindForm(aFormClass: TFormBaseClass; const aKey: integer): TFormBase;
    function GetBusinessObject: TObjectBase;

    function BusinessObjectClass: TObjectBaseClass; virtual;
    procedure InitializeForm; virtual;
    procedure FinalizeForm; virtual;

  public

    constructor Create(Owner: TComponent); override;

    class function NewInteger: integer;

    class function FormMain: TFormBase;

    class function FetchForm(const aKey: integer): TFormBase; virtual;

    property Key: integer read FKey write FKey;

    property BusinessObject: TObjectBase read GetBusinessObject;

    public destructor Destroy; override;
    procedure ShowForm;
    class procedure CloseAll;
    class function FormCount: integer;
    procedure Save;
  end;

implementation

uses UnitFormMain;

{$R *.DFM}

var FListForms: TList;

procedure TFormBase.ShowForm;
begin
  if (WindowState = wsMinimized) then
    WindowState := wsNormal;
  Show;
end;

procedure TFormBase.FormShow(Sender: TObject);
begin
  if (Self = FormMain) then
    Self.SetBounds(0, 0, Self.Width, Self.Height)
  else
      Self.SetBounds(FormMain.Left, (FormMain.Top + FormMain.Height), Self.Width, Self.Height);
end;

destructor TFormBase.Destroy;
begin
  FinalizeForm;
  AncestorFinalizeForm;
  FListForms.Remove(Self);
  inherited;
end;

function TFormBase.EqualsSignature(
  aFormClass: TFormBaseClass; const anKey: integer): boolean;
begin
  Result := ( (Self.ClassType = aFormClass) and (Self.Key = anKey) );
end;

class function TFormBase.FetchForm(const aKey: integer): TFormBase;
begin
  // "Self" in a class method referes to the class type

  // See if the form already exists
  Result := FindForm(Self, aKey);
  if (Result = NIL) then begin
    Result := Self.PrivateCreate(Application);
    // Add the newly created form to the list of all existing forms.
    FListForms.Add(Result);
    Result.Key := aKey;
    // Do special ancestor-level initializations.
    Result.AncestorInitializeForm;
    // Now that everything is set up in the architecture run sub-classing
    // form's implementation of InitializeForm
    Result.InitializeForm;
  end; // then begin
end;

class function TFormBase.FindForm(aFormClass: TFormBaseClass;
  const aKey: integer): TFormBase;
var i: integer;
var aForm: TFormBase;
begin
  Result := NIL;
  for i := 0 to FListForms.Count - 1 do begin
    aForm := TFormBase(FListForms.Items[i]);
    if ( aForm.EqualsSignature(aFormClass, aKey) ) then begin
      Result := aForm;
      exit;
    end; // then begin
  end; // do begin
end;

procedure TFormBase.AncestorInitializeForm;
begin
end;

procedure TFormBase.AncestorFinalizeForm;
begin
end;

var PrivateClassNewInteger: integer;
class function TFormBase.NewInteger: integer;
begin
  inc(PrivateClassNewInteger);
  Result := PrivateClassNewInteger;
end;

function TFormBase.GetBusinessObject: TObjectBase;
begin
  if (FBusinessObject = NIL) and (BusinessObjectClass <> NIL) then
     FBusinessObject := BusinessObjectClass.FetchReference(Self, Key);
  Result := FBusinessObject;
end;

procedure TFormBase.FinalizeForm;
begin
  FBusinessObject.FreeReference(Self);
  FBusinessObject := NIL;
end;

procedure TFormBase.InitializeForm;
begin
end;

function TFormBase.BusinessObjectClass: TObjectBaseClass;
begin
  Result := NIL;
end;

class function TFormBase.FormMain: TFormBase;
begin
  Result := UnitFormMain.FormMain; // Be careful not to do a recursive call here.
end;

class procedure TFormBase.CloseAll;
var i: integer;
begin
  for i := FListForms.Count - 1 downto 0 do begin
    TFormBase(FListForms.Items[i]).Close;
  end;
end;

class function TFormBase.FormCount: integer;
begin
  Result := FListForms.Count;
end;

procedure TFormBase.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFormBase.Save;
begin
  if (BusinessObject <> NIL) then
    BusinessObject.Save;
end;

procedure TFormBase.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := TRUE;
  // BusinessObject will be NIL for the main form and list forms
  if (BusinessObject <> NIL) and (BusinessObject.UpdatesPending) then begin
    case MessageDlg('Save changes before closing?', mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
      mrYes: BusinessObject.Save;
      mrNo: BusinessObject.Cancel;
      else CanClose := FALSE;
    end; // case
  end; // then begin

end;

constructor TFormBase.Create(Owner: TComponent);
begin
  inherited;
  // FormMain is the only form that should be auto-created.
  if (Self.ClassType <> TFormMain) then
    MessageDlg('TFormBase.Create is being run. Check that the form ' + Self.Name + ' is not being auto-created.', mtError, [mbOK], 0);
end;

constructor TFormBase.PrivateCreate(Owner: TComponent);
begin
  inherited Create(Owner);
end;

initialization

  FListForms := TList.Create;
{******************************************************************************}

finalization

  FListForms.Free;
{******************************************************************************}

end.